home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / sicp.scm < prev    next >
Encoding:
Text File  |  1992-02-17  |  1.5 KB  |  67 lines
  1. ; Compatibility mode for use with Abelson & Sussman's book,
  2. ; Structure & Interpretation of Computer Programs.
  3. ; This is intended to be loaded into Pseudoscheme.
  4.  
  5. (define-syntax cons-stream
  6.   (lambda (e r c) `(,(r 'cons) ,(cadr e) (,(r 'delay) ,(caddr e)))))
  7.  
  8. (define head car)
  9. (define (tail s) (force (cdr s)))
  10. (define the-empty-stream '<the-empty-stream>)
  11. (define (empty-stream? s) (eq? s the-empty-stream))
  12.  
  13. (define-syntax sequence
  14.   (lambda (e r c) `(,(r 'begin) ,@(cdr e))))
  15.  
  16. (define t #t)
  17. (define nil #f)
  18. (define (atom? x) (not (pair? x)))
  19.  
  20. (define (print x)
  21.   (write x)
  22.   (newline))
  23. (define princ display)
  24. (define prin1 write)
  25.  
  26. (define (explode thing)
  27.   (map (lambda (c) (string->symbol (string c)))
  28.        (string->list (cond ((symbol? thing)
  29.                 (symbol->string thing))
  30.                ((number? thing)
  31.                 (number->string thing))
  32.                (else
  33.                 (error "invalid argument to explode" thing))))))
  34.  
  35. (define (implode l)
  36.   (string->symbol (list->string (map (lambda (s)
  37.                        (string-ref (symbol->string s) 0))
  38.                      l))))
  39.  
  40. (define mapcar map)
  41. (define mapc for-each)
  42.  
  43. (define (1+ x) (+ x 1))
  44. (define (-1+ x) (- x 1))
  45.  
  46. (define (get sym ind)
  47.   (lisp:or (lisp:get sym ind) #f))
  48.  
  49. (define (put sym ind val)
  50.   (lisp:setf (lisp:get sym ind) val))
  51.  
  52.  
  53. ; AND and OR are procedures according to SICP.  Replace references
  54. ; as needed with *AND and *OR.
  55.  
  56. (define (*and . rest)
  57.   (let loop ((rest rest))
  58.     (if (null? rest)
  59.     #t
  60.     (and (car rest) (loop (cdr rest))))))
  61.  
  62. (define (*or . rest)
  63.   (let loop ((rest rest))
  64.     (if (null? rest)
  65.     #f
  66.     (or (car rest) (loop (cdr rest))))))
  67.